perm filename DFUNC.F4[MUS,LCS] blob sn#166832 filedate 1975-06-27 generic text, type T, neo UTF8
00100	C  ********** DISPLAY OUTPUT **********
00200		SUBROUTINE DPY(F,IY)
00300		DIMENSION F(1)
00400		IF(IY)GO TO 3
00450	C  IY IS TO SUPERIMPOSE WAVES FROM 'CRUNCH'
00500	2	CALL DPYX(IY)
00600		CALL DPYBRT(5)
00700	3	J=F(1)*256.0
00750		I=J+128
00800		CALL AIVECT(-256,I)
00900		DO 1017 K=2,512
01000		I=F(K)*256.0
01100		CALL RVECT(1,I-J)
01200	1017	J=I
01300		CALL DPYOUT(1)
01500		END
01600	
01700		SUBROUTINE DPYX(IGRID)
01800	C  ON DATADISK GRIDS MUST BE RESEST EACH TIME AROUND.
01810		COMMON/RD/ A(50,4),B(2,10),FN(10),XA(10),AA(4,178,10)
01855		1,LX,JX,JT,IDEL,FNUM,FNUM1,Z,FLNM,FLNM1,KT
01900		COMMON FUNC(512),F2(512),K,I
02000		COMMON/DY/IDPY(800),NUMS(5)
02200		DATA NUMS/'1','25','50','75','100'/
02300		CALL DDCLR
02400	C75	CALL CLRPOG(1)
02500		IT=-180
02600		IB=-500
02800		CALL TYPLOC(IT,IB)
02900		CALL DPYSET(1,IDPY,800)
03000		CALL DPYBRT(2)
03100		IF(IGRID.NE.1)GO TO 2
03200		CALL ALINE(256,128,-258,128)
03300		CALL ALINE(-256,-128,-256,384)
03325	10	CALL DPYBIG(6)
03350		CALL DPYTXT(-410,240,FNUM1,1)
03400		CALL DPYOUT(1)
03500		RETURN
03600	
03700	C  DRAWS GRIDWORK
03800	2	DO 501 K=384,-128,-128
03900	501	CALL ALINE(256,K,-258,K)
04000		DO 502 K=-256,260,128
04100	502	CALL ALINE(K,-130,K,384)
04200		N=-268
04300		CALL DPYBIG(3)
04400		CALL DPYTXT(-285,124,'0',1)
04500		DO 503 K=1,5
04600		CALL DPYTXT(N,388,NUMS(K),1)
04700	503	N=N+128
04800	C  NUMBERS OVER GRID
04900		GO TO 10
05000		END
05100	
05200		SUBROUTINE PLOTIT(FUNC,EY,P)
05210		COMMON/RD/ A(50,4),B(2,10),FN(10),XA(10),AA(4,178,10)
05230		1,LX,JX,JT,IDEL,FNUM,FNUM1,Z,FLNM,FLNM1,KT
05300		DIMENSION FUNC(1)
05310		IF(P.EQ.'P')GO TO 1
05315		IF(P.EQ.0)GO TO 4
05317		Y=1
05320		X=2.
05321		IF(P.NE.'X')GO TO 6
05323		X=1.5
05324		Y=.5
05325	6	CALL PLOTS(K)
05327		P=0
05330		GO TO 40
05400	1	TYPE 2
05440		CALL PLOTS(K)
05500		ACCEPT 3,X
05600		IF(X.EQ.0)X=SZX
05700		IF(X.EQ.0)X=1.
05800		SZX=X
05900	40	SZ=X/5.12
05910		S=0
05920		J=1
06010		JK=X*3
06020		CALL SYMBOL(SZ,4.*SZ,JK,0,FLNM,5)
06030	4	CALL SYMBOL(SZ,-3.*SZ,JK,0,B(2,JX),3)
06080		CALL PLOT(5.12*SZ,0.,3)
06090		CALL PLOT(0.,0.,2)
06100		CALL PLOT(0.,-2.*SZ,3)
06200		CALL PLOT(0.,2.*SZ,2)
06500	
06600	72	CALL PLOT(.01*SZ,FUNC(1)*2.*SZ,3)
06700		DO 73 K=2,512
06800		R=K/100.0
06900	73	CALL PLOT(R*SZ,FUNC(K)*2.*SZ,2)
06910		T=0
06920		Q=Y+5*SZ
06930		IF(J.NE.5)GO TO 5
06940		Q=-S
06950		T=-7*SZ
07000	5	CALL PLOT(Q,T,-3)
07010		S=S+Q
07020		J=J+1
07200	
07300	2	FORMAT(' TYPE SIZE - '$)
07400	3	FORMAT(F)
07500		END